home *** CD-ROM | disk | FTP | other *** search
/ Precision Software Appli…tions Silver Collection 1 / Precision Software Applications Silver Collection Volume One (PSM) (1993).iso / children / mazes4.exe / LISTMAZE.PAS < prev    next >
Pascal/Delphi Source File  |  1989-02-22  |  10KB  |  313 lines
  1. PROGRAM listmaze;
  2.   {
  3.          This program will display a maze.  A different random number seed
  4.     will produce a different maze.
  5.  
  6.          Written by James L. Dean
  7.                     406 40th Street
  8.                     New Orleans, LA 70124
  9.   }
  10.   USES Crt;
  11.  
  12.   CONST
  13.  
  14.     num_columns = 39;
  15.     x_max = 78;       {2*num_columns}
  16.     num_rows = 21;
  17.     y_max = 42;       {2*num_rows}
  18.  
  19.   VAR
  20.     delta_index_1              : INTEGER;
  21.     delta_index_1a             : INTEGER;
  22.     delta_index_1b             : INTEGER;
  23.     delta_index_1c             : INTEGER;
  24.     delta_index_1d             : INTEGER;
  25.     delta_index_2              : INTEGER;
  26.     delta_x                    : ARRAY [1..4,1..24] OF INTEGER;
  27.     delta_y                    : ARRAY [1..4,1..24] OF INTEGER;
  28.     digit                      : INTEGER;
  29.     digit_num                  : INTEGER;
  30.     page                       : ARRAY [0..y_max,0..x_max] OF CHAR;
  31.     r_n                        : ARRAY [1..8] OF INTEGER;
  32.     r_n_index_1                : INTEGER;
  33.     r_n_index_2                : INTEGER;
  34.     seed                       : STRING[8];
  35.     sum                        : INTEGER;
  36.     tem_int                    : INTEGER;
  37.     x                          : INTEGER;
  38.     x_next                     : INTEGER;
  39.     x_out                      : INTEGER;
  40.     x_wall_1                   : INTEGER;
  41.     y                          : INTEGER;
  42.     y_next                     : INTEGER;
  43.     y_out                      : INTEGER;
  44.     y_wall_1                   : INTEGER;
  45.  
  46.   PROCEDURE add_room;
  47.     VAR
  48.       delta_index_1 : BYTE;
  49.       delta_index_2 : BYTE;
  50.     BEGIN
  51.       page[y,x]:=' ';
  52.       delta_index_1:=1;
  53.       REPEAT
  54.         delta_index_2:=r_n[1];
  55.         r_n_index_1:=1;
  56.         FOR r_n_index_2:=2 TO 8 DO
  57.           BEGIN
  58.             tem_int:=r_n[r_n_index_2];
  59.             r_n[r_n_index_1]:=tem_int;
  60.             delta_index_2:=delta_index_2+tem_int;
  61.             IF delta_index_2 > 29 THEN
  62.               delta_index_2:=delta_index_2-29;
  63.             r_n_index_1:=r_n_index_2
  64.           END;
  65.         r_n[8]:=delta_index_2
  66.       UNTIL
  67.         (delta_index_2 <= 24);
  68.       WHILE (delta_index_1 <= 4) DO
  69.         BEGIN
  70.           x_next:=x+2*delta_x[delta_index_1][delta_index_2];
  71.           IF ((x_next <= 0) OR (x_next >= x_max)) THEN
  72.             delta_index_1:=delta_index_1+1
  73.           ELSE
  74.             BEGIN
  75.               y_next:=y+2*delta_y[delta_index_1][delta_index_2];
  76.               IF ((y_next <= 0) OR (y_next >= y_max)) THEN
  77.                 delta_index_1:=delta_index_1+1
  78.               ELSE
  79.                 IF page[y_next,x_next] = 'W' THEN
  80.                   BEGIN
  81.                     IF x = x_next THEN
  82.                       BEGIN
  83.                         y_wall_1:=(y+y_next) DIV 2;
  84.                         page[y_wall_1,x_next]:=' '
  85.                       END
  86.                     ELSE
  87.                       BEGIN
  88.                         x_wall_1:=(x+x_next) DIV 2;
  89.                         page[y_next,x_wall_1]:=' '
  90.                       END;
  91.                     x:=x_next;
  92.                     y:=y_next;
  93.                     add_room;
  94.                     x:=x-2*delta_x[delta_index_1][delta_index_2];
  95.                     y:=y-2*delta_y[delta_index_1][delta_index_2]
  96.                   END
  97.                 ELSE
  98.                   delta_index_1:=delta_index_1+1
  99.             END
  100.         END
  101.     END;
  102.  
  103.   BEGIN
  104.     ClrScr;
  105.     WRITELN(OUTPUT,'                                 Maze Generator');
  106.     WRITELN(OUTPUT,' '); WRITELN(OUTPUT,' '); WRITELN(OUTPUT,' ');
  107.     WRITE(OUTPUT,'     Random number seed?  ');
  108.     READLN(INPUT,seed);
  109.     r_n_index_1:=1;
  110.     FOR r_n_index_2:=1 TO LENGTH(seed) DO
  111.       BEGIN
  112.         tem_int:=ORD(seed[r_n_index_2]);
  113.         WHILE (tem_int > 29) DO tem_int:=tem_int-29;
  114.         r_n[r_n_index_1]:=tem_int;
  115.         r_n_index_1:=r_n_index_1+1
  116.       END;
  117.     r_n_index_2:=8;
  118.     WHILE (r_n_index_1 > 1) DO
  119.       BEGIN
  120.         r_n_index_1:=r_n_index_1-1;
  121.         r_n[r_n_index_2]:=r_n[r_n_index_1];
  122.         r_n_index_2:=r_n_index_2-1
  123.       END;
  124.     WHILE (r_n_index_2 >= 1) DO
  125.       BEGIN
  126.         r_n[r_n_index_2]:=19;
  127.         r_n_index_2:=r_n_index_2-1
  128.       END;
  129.     delta_x[1,1]:=-1;
  130.     delta_y[1,1]:=0;
  131.     delta_x[2,1]:=0;
  132.     delta_y[2,1]:=1;
  133.     delta_x[3,1]:=1;
  134.     delta_y[3,1]:=0;
  135.     delta_x[4,1]:=0;
  136.     delta_y[4,1]:=-1;
  137.     delta_index_2:=0;
  138.     FOR delta_index_1a:=1 TO 4 DO
  139.       FOR delta_index_1b:=1 TO 4 DO
  140.         IF delta_index_1a <> delta_index_1b THEN
  141.           FOR delta_index_1c:=1 TO 4 DO
  142.             IF ((delta_index_1a <> delta_index_1c)
  143.             AND (delta_index_1b <> delta_index_1c)) THEN
  144.               FOR delta_index_1d:=1 TO 4 DO
  145.                 IF ((delta_index_1a <> delta_index_1d)
  146.                 AND (delta_index_1b <> delta_index_1d)
  147.                 AND (delta_index_1c <> delta_index_1d)) THEN
  148.                   BEGIN
  149.                     delta_index_2:=delta_index_2+1;
  150.                     delta_x[delta_index_1a,delta_index_2]:=delta_x[1,1];
  151.                     delta_y[delta_index_1a,delta_index_2]:=delta_y[1,1];
  152.                     delta_x[delta_index_1b,delta_index_2]:=delta_x[2,1];
  153.                     delta_y[delta_index_1b,delta_index_2]:=delta_y[2,1];
  154.                     delta_x[delta_index_1c,delta_index_2]:=delta_x[3,1];
  155.                     delta_y[delta_index_1c,delta_index_2]:=delta_y[3,1];
  156.                     delta_x[delta_index_1d,delta_index_2]:=delta_x[4,1];
  157.                     delta_y[delta_index_1d,delta_index_2]:=delta_y[4,1]
  158.                   END;
  159.     FOR y_out:=0 TO y_max DO
  160.       FOR x_out:=0 TO x_max DO
  161.         page[y_out,x_out]:='W';
  162.     sum:=0;
  163.     FOR digit_num:=1 TO 3 DO
  164.       BEGIN
  165.         digit:=r_n[1];
  166.         r_n_index_1:=1;
  167.         FOR r_n_index_2:=2 TO 8 DO
  168.           BEGIN
  169.             tem_int:=r_n[r_n_index_2];
  170.             r_n[r_n_index_1]:=tem_int;
  171.             digit:=digit+tem_int;
  172.             IF digit > 29 THEN
  173.               digit:=digit-29;
  174.             r_n_index_1:=r_n_index_2
  175.           END;
  176.         r_n[8]:=digit;
  177.         sum:=29*sum+digit
  178.       END;
  179.     x:=2*(sum MOD num_columns)+1;
  180.     sum:=0;
  181.     FOR digit_num:=1 TO 3 DO
  182.       BEGIN
  183.         digit:=r_n[1];
  184.         r_n_index_1:=1;
  185.         FOR r_n_index_2:=2 TO 8 DO
  186.           BEGIN
  187.             tem_int:=r_n[r_n_index_2];
  188.             r_n[r_n_index_1]:=tem_int;
  189.             digit:=digit+tem_int;
  190.             IF digit > 29 THEN
  191.               digit:=digit-29;
  192.             r_n_index_1:=r_n_index_2
  193.           END;
  194.         r_n[8]:=digit;
  195.         sum:=29*sum+digit
  196.       END;
  197.     y:=2*(sum MOD num_rows)+1;
  198.     add_room;
  199.     page[0,1]:=' ';
  200.     page[y_max,x_max-1]:=' ';
  201.     ClrScr;
  202.     WRITE(OUTPUT,CHR(179));
  203.     x:=1;
  204.     WHILE (x < x_max) DO
  205.       BEGIN
  206.         IF page[0,x] = 'W' THEN
  207.           WRITE(OUTPUT,CHR(196))
  208.         ELSE
  209.           WRITE(OUTPUT,' ');
  210.         x:=x+1;
  211.         IF x < x_max THEN
  212.           BEGIN
  213.             IF page[1,x] = 'W' THEN
  214.               WRITE(OUTPUT,CHR(194))
  215.             ELSE
  216.               WRITE(OUTPUT,CHR(196));
  217.             x:=x+1
  218.           END
  219.       END;
  220.     WRITE(OUTPUT,CHR(191));
  221.     WRITELN(OUTPUT);
  222.     y:=2;
  223.     WHILE(y < y_max) DO
  224.       BEGIN
  225.         IF page[y,1] = 'W' THEN
  226.           WRITE(OUTPUT,CHR(195))
  227.         ELSE
  228.           WRITE(OUTPUT,CHR(179));
  229.         x:=1;
  230.         WHILE (x < x_max) DO
  231.           BEGIN
  232.             IF page[y,x] = 'W' THEN
  233.               WRITE(OUTPUT,CHR(196))
  234.             ELSE
  235.               WRITE(OUTPUT,' ');
  236.             x:=x+1;
  237.             IF x < x_max THEN
  238.               BEGIN
  239.                 IF page[y,x-1] = 'W' THEN
  240.                   IF page[y-1,x] = 'W' THEN
  241.                     IF page[y+1,x] = 'W' THEN
  242.                       IF page[y,x+1] = 'W' THEN
  243.                         WRITE(OUTPUT,CHR(197))
  244.                       ELSE
  245.                         WRITE(OUTPUT,CHR(180))
  246.                     ELSE
  247.                       IF page[y,x+1] = 'W' THEN
  248.                         WRITE(OUTPUT,CHR(193))
  249.                       ELSE
  250.                         WRITE(OUTPUT,CHR(217))
  251.                   ELSE
  252.                     IF page[y+1,x] = 'W' THEN
  253.                       IF page[y,x+1] = 'W' THEN
  254.                         WRITE(OUTPUT,CHR(194))
  255.                       ELSE
  256.                         WRITE(OUTPUT,CHR(191))
  257.                     ELSE
  258.                       WRITE(OUTPUT,CHR(196))
  259.                 ELSE
  260.                   IF page[y-1,x] = 'W' THEN
  261.                     IF page[y+1,x] = 'W' THEN
  262.                       IF page[y,x+1] = 'W' THEN
  263.                         WRITE(OUTPUT,CHR(195))
  264.                       ELSE
  265.                         WRITE(OUTPUT,CHR(179))
  266.                     ELSE
  267.                       IF page[y,x+1] = 'W' THEN
  268.                         WRITE(OUTPUT,CHR(192))
  269.                       ELSE
  270.                         WRITE(OUTPUT,CHR(179))
  271.                   ELSE
  272.                     IF page[y+1,x] = 'W' THEN
  273.                       IF page[y,x+1] = 'W' THEN
  274.                         WRITE(OUTPUT,CHR(218))
  275.                       ELSE
  276.                         WRITE(OUTPUT,CHR(179))
  277.                     ELSE
  278.                       IF page[y,x+1] = 'W' THEN
  279.                         WRITE(OUTPUT,CHR(196))
  280.                       ELSE
  281.                         WRITE(OUTPUT,' ');
  282.                 x:=x+1
  283.               END
  284.           END;
  285.         IF page[y,x_max-1] = 'W' THEN
  286.           WRITE(OUTPUT,CHR(180))
  287.         ELSE
  288.           WRITE(OUTPUT,CHR(179));
  289.         y:=y+2;
  290.         WRITELN(OUTPUT)
  291.       END;
  292.     WRITE(OUTPUT,CHR(192));
  293.     x:=1;
  294.     WHILE(x < x_max) DO
  295.       BEGIN
  296.         IF page[y_max,x] = 'W' THEN
  297.           WRITE(OUTPUT,CHR(196))
  298.         ELSE
  299.           WRITE(OUTPUT,' ');
  300.         x:=x+1;
  301.         IF x < x_max THEN
  302.           BEGIN
  303.             IF page[y_max-1,x] = 'W' THEN
  304.               WRITE(OUTPUT,CHR(193))
  305.             ELSE
  306.               WRITE(OUTPUT,CHR(196));
  307.             x:=x+1
  308.           END
  309.       END;
  310.     WRITE(OUTPUT,CHR(179));
  311.     WRITELN(OUTPUT);
  312.   END.
  313.